Delphi Developer's Kit 1996/Delphi Developer's Kit 1996.iso/power/csv/convert.pas

Pascal/Delphi Source File | 1995-12-22 | 9KB | 317 lines

unit Convert;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, DBTables, DB, Grids, DBGrids;

Const
  Delimiter = '"';
  Separator = ',';
  Special   = '';{Alt 127}
  MaxField = 128; {Each line is 256 bytes in length and a comma after each value}
  FieldTypeStr : Array[TFieldType] of String[15] =
    ('ftUnknown','ftString','ftSmallint','ftInteger','ftWord',
     'ftBoolean',' ftFloat','ftCurrency','ftBCD','ftDate','ftTime',
     'ftDateTime','ftBytes','ftVarBytes','ftBlob','ftMemo','ftGraphic');

Type
  FieldsType = record
    Count    : Byte;
    Field    : Array[1..MaxField] of record
      FieldIs  : TFieldType;
      FieldLen : Byte;
    end;
  end;

type
  TForm1 = class(TForm)
    Table1: TTable;
    Table2: TTable;
    BatchMove1: TBatchMove;
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    ListBox1: TListBox;
    Edit2: TEdit;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    Procedure FieldSizeAndTypeOf(Line : String; Nth : Byte; var Field : TFieldType; var Size : Byte);
    Procedure FindFieldTypes(Filename : String; var Fields : FieldsType);
    Procedure DefineFields(var Table2 : TTable; Filename : String);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

Type
  MyException = class(Exception);

Function Word2Str(W : Word) : String;
var
  S : String;
begin
  Str(W,S);
  Word2Str := S;
end;

Procedure PreProcess(var S : String);
var
  InText : Boolean;
  C      : Byte;
begin
  {Convert any separators within delimitors into a special character}
  {i.e. "Hello world, How are you", becomes
        "Hello world How are you"}
  C := Pos(Delimiter,S);
  if C<>0 then begin
    {Don't bother trying to any conversion if there are no delimitors!}
    InText := False;
    for C := 1 to Length(S) do begin
      if S[C]=Delimiter then
        InText:=not InText;
      if (S[C]=Separator) and InText then
        S[C] := Special;
    end;
  end;
end;

Function CountSeparators(S : String) : Word;
var
  P,C    : Byte;
begin
  C := 1;
  P := Pos(Separator,S);
  while P<>0 do begin
    Inc(C);
    S[P] := ' ';
    P := Pos(Separator,S);
  end;
  CountSeparators := C;
end;

Function  NthItem(N : Byte; S : String) : String;
var
  P,C : Byte;
begin
  C := 1;
  P := Pos(',',S);
  while (C<>N) do begin
    Inc(C);
    Delete(S,1,P);
    P := Pos(Separator,S);
  end;
  if P>0 then
    Delete(S,P,Length(S)-P+1); {Chop the end off the string}
  {Remove any delimiters from around the string}
  if S[1]=Delimiter then
    Delete(S,1,1);
  if S[Length(S)]=Delimiter then
    Delete(S,Length(S),1);

  {Convert any specials back to separators}
  P := Pos(Special, S);
  while P<>0 do begin
    S[P] := Separator;
    P := Pos(Special, S);
  end;
  NthItem := S;
end;

Procedure TForm1.FieldSizeAndTypeOf(Line : String; Nth : Byte; var Field : TFieldType; var Size : Byte);
var
  P,C : Byte;
  Numbs,
  Letts : Boolean;
  Punct : String;
begin
  Line := NthItem(Nth, Line);

  Field := ftUnknown;
  Size := 0;
  {Determine field type}
  if Length(Line)>1 then begin
    Numbs := False;
    Letts := False;
    Punct := '';
    for C := 1 to Length(Line) do begin
      if not Letts and (Line[C] in ['A'..'Z',' ','a'..'z']) then
        Letts := True;
      if not Numbs and (Line[C] in ['0'..'9']) then
        Numbs := True;
      if not (Line[C] in ['A'..'Z',' ','a'..'z','0'..'9']) then
        if Pos(Line[C],Punct)=0 then
          Punct := Punct + Line[C];
    end;
    if Numbs and not Letts then begin
      if Punct='' then begin
        {Its a number}
        Field := ftInteger;
      end else begin
        {Its numbers and punctuation so could be date,time or real}
        if Length(Punct)=1 then begin
          Case Punct[1] of
            ':' : Field := ftTime;
            '/' : Field := ftDate;
            '.' : Field := ftFloat;
          else
            Field := ftString;
          end;
        end else
          Field := ftString;
      end;
    end else
      Field := ftString;
    Case Field of
      ftString : Size := Length(Line);
    end;
  end;
end;

Procedure TForm1.FindFieldTypes(Filename : String; var Fields : FieldsType);
var
  Fil    : TextFile;
  Line   : String;
  C      : Byte;
  TmpIs  : TFieldType;
  TmpLen : Byte;
begin
  FillChar(Fields, SizeOf(Fields), 0);

  try
    AssignFile(Fil,Filename);
    Reset(Fil);
    with Fields do begin
      Count := 0;
      ListBox1.Clear;
      repeat
        Readln(Fil,Line);
        Edit2.Text := Line;
        Edit2.Refresh;
        PreProcess(Line);
        C := CountSeparators(Line);
        if (C<>Count) then begin
          if (Count<>0) then
            Raise MyException.Create('Inconsistant number of fields!');
          Count := C;
          Edit1.Text := Word2Str(C);
          Edit1.Refresh;
        end;

        for C := 1 to Count do with Field[C] do begin
          FieldSizeAndTypeOf(Line,C,TmpIs,TmpLen);
          if (TmpIs<>FieldIs) then begin
            if FieldIs=ftUnknown then begin
              ListBox1.Items.Add(Word2Str(C)+' '+FieldTypeStr[TmpIs]+' '+Word2Str(TmpLen));
              ListBox1.Refresh;
            end else if TmpIs<>ftUnknown then
              Raise MyException.Create('Field '+Chr(C+Ord('0'))+' has changed type!');
          end;
          if TmpIs<>ftUnknown then begin
            FieldIs := TmpIs;
            if TmpLen>FieldLen then begin
              ListBox1.Items.Add(Word2Str(C)+' '+FieldTypeStr[FieldIs]+' '+Word2Str(TmpLen));
              ListBox1.Items.Exchange(C-1,ListBox1.Items.Count-1);
              ListBox1.Items.Delete(ListBox1.Items.Count-1);
              ListBox1.Refresh;
              FieldLen := TmpLen;
            end;
          end;
        end;
      until Eof(Fil);
      for C := 1 to Count do with Field[C] do begin
        {Any fields we cannot understand are strings!}
        if FieldIs=ftUnknown then
          FieldIs := ftString;
        {Any String fields with no length have to be at least 1 in length!}
        if (FieldLen=0) and (FieldIs=ftString) then
          FieldLen := 1;
      end;
    end;
  finally
    CloseFile(Fil);
  end;
end;

Procedure TForm1.DefineFields(var Table2 : TTable; Filename : String);
var
  Fields : FieldsType;
  Fil    : TextFile;
  C      : Byte;
begin
  FindFieldTypes(Filename, Fields);

  with Table2 do begin
    FieldDefs.Clear;
    IndexDefs.Clear;
  end;

  AssignFile(Fil,Copy(Filename,1,Pos('.',Filename)-1)+'.SCH');
  ReWrite(Fil);
  Writeln(Fil,'[',ExtractFilename(Copy(Filename,4,Pos('.',Filename)-4)),']');
  Writeln(Fil,'Filetype=VARYING');
  Writeln(Fil,'Delimiter="');
  Writeln(Fil,'Separator=,');
  Writeln(Fil,'CharSet=ascii');
  with Fields do begin
    for C := 1 to Count do with Field[C] do begin
      Write(Fil,'Field',C,'=','Field',C,',');
      Case FieldIs of
        ftInteger : Writeln(Fil,'LONGINT,',FieldLen,',0,0');
        ftFloat   : Writeln(Fil,'FLOAT,',FieldLen,',',(FieldLen-1 div 2)+1,',0');
        ftDate    : Writeln(Fil,'DATE,',FieldLen,',0,0');
        ftTime    : Writeln(Fil,'TIME,',FieldLen,',0,0');
      else
        Writeln(Fil,'CHAR,',FieldLen,',0,0');
      end;
      Table2.FieldDefs.Add('Field'+Word2Str(C), FieldIs, FieldLen, False);
      if C=1 then
        Table2.IndexDefs.Add('Field'+Word2Str(C)+'Index', 'Field'+Word2Str(C), [ixPrimary, ixUnique]);
    end;
  end;
  System.Close(Fil);
  Table2.CreateTable;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Define : Boolean;
  DBFile : String;
  Button : Integer;
  P      : Byte;
begin
  if OpenDialog1.Execute then begin
    Table1.Tablename := OpenDialog1.Filename;
    P := Pos('.',OpenDialog1.Filename);
    DBFile := Copy(OpenDialog1.Filename,1,P-1);
    Define := True;
    Button := IDNO;
    with Table2 do begin
      Active := False;
      Databasename := DBFile;
      TableName := DBFile+'.DB';
      TableType := ttParadox;
    end;
    if FileExists(DBFile+'.DB') then begin
      Button := Application.MessageBox('Delete Old Table and Continue?', 'Table Exists', mb_YesNoCancel + mb_DefButton1);
      Define := (Button = IDYES);
    end;
    if Define then
      DefineFields(Table2,OpenDialog1.Filename);
    if Button<>IDCANCEL then
      BatchMove1.Execute;
  end;
end;

end.